home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Just Call Me Internet
/
Just Call Me Internet.iso
/
prog
/
atari
/
m2
/
cat3src
/
cat
/
parser.i
< prev
next >
Wrap
Text File
|
1997-10-26
|
91KB
|
2,387 lines
IMPLEMENTATION MODULE Parser;
(*==============================================================*
* Modul: CAT-Outfile Parser, neue Version *
* Autor: Johannes Gttker-Schnetmann *
* erstellt am: 09.03.1992 *
* letzte nderung am: 29.12.1992 *
* Version: 1.0 *
* Interne Version: V#0005 *
*==============================================================*
Kleinere Problemchen:
- Wenn whrend der Sortierungsphase ab der zweiten neuen Gruppe etwas
schief luft, dann sind diese Gruppen frderhin als dummy in der Liste,
bis zum ersten Mal doch noch etwas in sie eingefgt wird.
- Array mit der Verkettungsinformationen noch statisch in diesem Modul
deklariert, das mu noch dynamisch werden
- Die Strings in InsertPersonal sind noch etwas ppig angegeben..
- Das Logfile darf nicht behandelt werden, wenn alle Nachrichten von
der Datenbank abgelehnt wurden.
*---------------------------------------------------------------------------
* Datum Vers. Autor nderung (Arbeitsbericht)
*---------------------------------------------------------------------------
* 09.03.92 0001 JGS Erste Version
* 10.03.92 0002 JGS Implementation .. -12./18.-20./22.
* 24.03.92 JGS Testen und Fehlerkorrigieren 25./
* 26.03.92 0003 JGS Maus-Logfile-Behandlung
* 15.04.92 0004 JGS Anpassung an WatchDog und Dupecheck
* 16.04.92 JGS Verbesserte Logdatei
* 24.05.92 JGS leere InfoFiles korrekt/Positionen sichern/Files schlieen
* 27.12.92 0005 JGS nach einigen nderungen, die hier nicht aufgefhrt sind..
* jetzt Gesamtstatistik eingebaut.
* 12.08.93 JGS Username kann ber die Variable 'Username' gesetzt werden
*---------------------------------------------------------------------------
*)
FROM SYSTEM IMPORT ADR, ADDRESS, CALLSYS, CADR, ASSEMBLER;
(* Megamax-spezifische Module *)
FROM Characters IMPORT CR, LF;
IMPORT BinOps;
IMPORT Block;
IMPORT StrConv;
IMPORT Strings;
(* MagicLib *)
IMPORT MagicAES;
IMPORT MagicDOS;
IMPORT MagicStrings;
IMPORT MagicCookie;
(* MagicTools *)
IMPORT mtDir;
IMPORT mtAppl;
IMPORT mtAlerts;
IMPORT mtTextfiles;
(* Cat-Module *)
FROM MTPaths IMPORT ImportPath, ARCPath, ARCName, DataPath,
MessagePath, archiveName;
FROM UserInformation IMPORT UserBLK, batchProcess;
FROM Void IMPORT v;
FROM Infofiles IMPORT LoadInfoInf, SaveInfoInf, SetInfoCrc, IsInfoFile,
TestDirectParse;
IMPORT ARCStarter;
IMPORT showImport;
IMPORT CatTypes;
IMPORT CatFiles;
IMPORT CatLog;
IMPORT CatGlobal;
IMPORT data;
IMPORT dataSys;
IMPORT MTE;
IMPORT Protokoll;
IMPORT Messages;
IMPORT ConfVars;
IMPORT Varnames;
IMPORT VDIStandards;
IMPORT WdwManager;
IMPORT GroupSelect;
IMPORT IoFilter;
IMPORT handlePool;
IMPORT CatHelp;
(* IMPORT Debug; (* $D+*) *)
(* Konstanten fr LOGFILE-Ausgabe *)
CONST
cSpace9Str = ' ';
cMessStr = ' Nachricht';
cExtStr = 'en';
cWarStr = ' war';
cDbStr = ' vom Datenbankmodul und ';
cWdogStr = ' vom WatchDog abgelehnt. ';
cImpStr = ' importiert.';
cGroupChange= 'Gruppenwechsel zu ';
cPrivate = 'Private Messages';
cSysop = 'SYSOP ';
cOfNdel = 'Outfile-Text konnte nicht gelscht werden';
cOfDel = 'Outfile-Text gelscht';
cUnknown = 'Unbekannter Eintrag: ';
CONST minSpace = LONG(MAX(INTEGER)); (* Mindestgre Outfile-Puffers *)
secureBytes = LONG(MAX(INTEGER)); (* Platz, der auf Einfgelaufwerk *)
(* zustzlich zur Lnge des *)
(* Outfiles noch vorhanden sein *)
(* mu *)
infoFileBuffer = 32*1024; (* Puffergre fr Textfiles *)
logFileBuffer = 16*1024;
errFileBuffer = 4*1024;
datFileBuffer = 4*1024;
sixteenKB = 64*1024 - 256; (* Das ist die maximale messagelnge,
* die wir akzeptieren
*)
OutfileTxt = "outfile.txt"; (* Mu noch einstellbar werden! *)
LogFile = 'LOG.txt';
HeadFile = 'HEAD.txt';
ErrFile = 'protokol.txt';
notDeleted = ' nicht gelscht';
isDupe = 'Dupe zu';
refNotFound = 'Mitteilung * nicht gefunden';
spaceForOwnMess = 99; (* Platz der bei der Behandlung des Logfiles *)
(* fr eigene Messages zu reservieren versucht *)
(* wird. *)
TYPE NrTypes = (LOG, REN, CMD, HEAD, mKOM, mNEW, mPER, mANS, normal, nottich);
(* Beim Einlagern wird jetzt schon versucht, die Gruppenliste in data zu *)
(* erweitern. Klappt dies nicht, dann wird das Einfgen abgebrochen! *)
(*
Idee:
Es wird ein kleines Array fr die Verkettungsinformation auf dem Stack
angelegt, dann werden cardinals fr die Verkettung benutzt, denn das
verbraucht weniger Platz und ist evtl. schneller. Das Array fat demnchst
vielleicht so etwa 1000 Msgs, fr die Testphase erheblich weniger, d.h. so
50 bis 100. Das Outfile wird in zwei Schleifen bearbeitet. In der ueren
wird es hppchenweise in den Speicher geladen und in der inneren
durchgesehen, bis das Verkettungsarray voll ist. d.h. Die innere Schleife
arbeitet den Block im Speicher ab.
*)
CONST EndOfList = 0FFFFH;
maxArray = 1000; (* Maximale Anzahl an Positionen pro Array *)
maxGroup = 1023;
TYPE onePosItem = RECORD
next : CARDINAL;
offset : LONGCARD
END;
TYPE onePosArrayPtr = POINTER TO onePosArray;
TYPE onePosArray = ARRAY[0..maxArray] OF onePosItem;
TYPE oneMaxArray = ARRAY[0..maxGroup] OF CARDINAL;
TYPE oneGroupSet = SET OF [0..maxGroup];
(* es wird ein Array der Startpositionen und eins mit den aktuellen
* Endwerten der einzelnen Gruppenlisten und ein Array mit der Verwaltungs-
* information verwaltet. Wenn eine neue Nachricht an eine Gruppenliste
* angehngt werden soll, so mu zunchst in dem Array mit den Start-
* positionen nachgesehen werden, ob noch kein Eintrag erfolgte. Anschlieend
* wird im letzten Element dieser Gruppe, das an der Position gMax[gruppe]
* steht, der neue Eintrag verkettet
*)
VAR maxOver : BOOLEAN; (* Maximalgre berschritten? *)
filteredToRead: BOOLEAN; (* Gefilterte auf Gelesen setzen? *)
firstLog: BOOLEAN; (* Erstes Logfile schon erstellt *)
headThere: BOOLEAN; (* #HEAD ist gekommen *)
groupsUsed: oneGroupSet;
redrawCheck: INTEGER;
(*
useLongIds: BOOLEAN; (* Lange IDs fr Nachrichten verwenden
*)
*)
(* Arrays mit der Verkettungsinformation, demnchst dynamisch, s.o. *)
VAR s, m : oneMaxArray;
g : onePosArray; (* Demnchst anfordern *)
PROCEDURE typeOf(VAR str : ARRAY OF CHAR):NrTypes;
BEGIN
IF str[0] = 0C THEN RETURN nottich
(*
ELSIF (str[0]='C') & (str[1]='M') & (str[2]='D') THEN RETURN CMD
*)
ELSIF (str[0]='L') & (str[1]='O') & (str[2]='G') THEN RETURN LOG
ELSIF (str[0]='R') & (str[1]='E') & (str[2]='N') THEN RETURN REN
ELSIF (str[0]='H') & (str[1]='E') & (str[2]='A') & (str[3]='D') THEN RETURN HEAD
(*
ELSIF (str[0]='K') & (str[1]='O') & (str[2]='M') THEN RETURN mKOM
ELSIF (str[0]='N') & (str[1]='E') & (str[2]='W') THEN RETURN mNEW
ELSIF (str[0]='P') & (str[1]='E') & (str[2]='R') THEN RETURN mPER
ELSIF (str[0]='A') & (str[1]='N') & (str[2]='S') THEN RETURN mANS
*)
ELSE RETURN normal END
END typeOf;
PROCEDURE isOneInf(VAR str : ARRAY OF CHAR; VAR infLen: INTEGER):BOOLEAN;
VAR p : CARDINAL;
infName: ARRAY [0..8] OF CHAR;
BEGIN
(*
IF (str[0] = 'I') OR (str[0] = 'J') THEN
*)
p := 0;
WHILE (str[p] > ' ') & (str[p] # '@') & (p <= 8) DO
infName[p] := str[p];
INC (p)
END;
IF (str[p] # '@') & (p <= 8) THEN
infName [p] := '';
infLen := p;
RETURN IsInfoFile (infName, TRUE);
END;
RETURN FALSE
(*
END;
RETURN FALSE
*)
END isOneInf;
PROCEDURE isUnknownInf(VAR str : ARRAY OF CHAR; VAR infLen: INTEGER):BOOLEAN;
VAR p : CARDINAL;
BEGIN
p := 0;
WHILE (str[p] > ' ') & (str[p] # '@') & (p <= 8) DO
INC (p)
END;
IF (str[p] # '@') & (p <= 8) THEN
infLen := p;
RETURN TRUE;
END;
RETURN FALSE
END isUnknownInf;
PROCEDURE OpenTextFile(REF path,
name : ARRAY OF CHAR;
mode : mtTextfiles.Textmode;
buff : CARDINAL;
VAR file : mtTextfiles.TEXTFILE):BOOLEAN;
VAR scrap : CatTypes.pathStrType;
BEGIN
MagicStrings.Assign(path, scrap);
MagicStrings.Append(name, scrap);
RETURN mtTextfiles.OpenTextfile(scrap, mode, buff, file) OR
mtTextfiles.OpenTextfile(scrap, mode, 1, file);
(* Falls kein Speicher mehr frei *)
END OpenTextFile;
(*- Logfile behandeln -----------------------------------------------------*)
PROCEDURE processLog();
VAR idScrap : CatTypes.String255;
shortId,
mscrap,
scrap : CatTypes.String255; (* Fr die Modi nach '#' und '"' *)
type : CHAR;
key : CHAR;
log : mtTextfiles.TEXTFILE;
err : mtTextfiles.TEXTFILE; (* Fehlermeldungen u.. *)
errOpen : BOOLEAN;
refAssigned,
refMess : BOOLEAN;
find : CARDINAL;
find2 : CARDINAL;
writeInf: BOOLEAN;
datOpen : BOOLEAN;
dat : data.OneGroupHandle;
gotId : BOOLEAN;
abort : BOOLEAN;
readNew : BOOLEAN;
anz,
anz2,
not2,
not : CARDINAL; (* WatchDog und defekte gibt's hier nicht. *)
PROCEDURE OpenPers (): BOOLEAN;
BEGIN
IF ~datOpen THEN
IF anz = 0
THEN
CatLog.WriteLn();
CatLog.WriteStringNTime(cGroupChange);
CatLog.WriteLine(cPrivate);
END;
datOpen := data.OpenOneGroup(dataSys.private, spaceForOwnMess, TRUE, dat);
IF ~datOpen THEN
RETURN FALSE
END;
END;
RETURN TRUE;
END OpenPers;
PROCEDURE WriteDat(VAR mess : data.PtrRecord; VAR abort : BOOLEAN):BOOLEAN;
VAR isDupe: BOOLEAN;
succ : BOOLEAN;
BEGIN
IF ~OpenPers() THEN RETURN FALSE END;
IF datOpen THEN
succ := data.AppendMessage(dat, data.own, {}, mess, v.bool, v.bool, isDupe, abort);
IF ~succ
THEN
(* Eigener Dupe, kommt durch :PE *)
IF isDupe THEN RETURN TRUE END;
END;
RETURN succ;
END;
RETURN FALSE;
END WriteDat;
PROCEDURE CloseDat(VAR abort : BOOLEAN; newMsgs : CARDINAL);
BEGIN
IF datOpen THEN
data.CloseOneWriteGroup(dat, newMsgs, ~abort, abort);
datOpen := FALSE;
END;
END CloseDat;
PROCEDURE ErrorWrite(REF str : ARRAY OF CHAR);
BEGIN
IF ~errOpen THEN
errOpen := OpenTextFile(DataPath, ErrFile, mtTextfiles.WRITE, errFileBuffer, err);
END;
IF errOpen THEN
mtTextfiles.WriteLine(err, str);
END;
END ErrorWrite;
PROCEDURE ErrorLn();
BEGIN
IF errOpen THEN
mtTextfiles.WriteLn(err);
END;
END ErrorLn;
PROCEDURE ErrorClose();
BEGIN
IF errOpen THEN
mtTextfiles.CloseTextfile(err);
END;
END ErrorClose;
PROCEDURE DeleteThem(REF path, name, ext : ARRAY OF CHAR);
VAR nameScrap : CatTypes.nameStrType;
BEGIN
MagicStrings.Assign(name, nameScrap);
MagicStrings.Append(ext, nameScrap);
IF ~CatFiles.DeleteFile(path, nameScrap) THEN
ErrorWrite(nameScrap);
ErrorWrite(' konnte nicht gelscht werden.');
ErrorLn();
END;
END DeleteThem;
PROCEDURE InsertPersonal(VAR id, longId, name : ARRAY OF CHAR);
VAR nameScrap : CatTypes.nameStrType;
theFile : mtTextfiles.TEXTFILE;
mess : data.PtrRecord;
refId,
rId,
to,
wegen,
EZeile : CatTypes.Str1023Ptr;
(*
str : ARRAY[0..3] OF CatTypes.String255;
*)
z : CARDINAL;
PROCEDURE OpenFile(REF ext : ARRAY OF CHAR):BOOLEAN;
BEGIN
MagicStrings.Assign(name, nameScrap);
MagicStrings.Append(ext, nameScrap);
IF ~OpenTextFile(MessagePath,
nameScrap,
mtTextfiles.READ,
datFileBuffer,
theFile)
THEN
ErrorWrite('Folgende Datei konnte nicht geffnet werden:');
ErrorLn();
ErrorWrite(nameScrap);
ErrorLn();
RETURN FALSE
END;
RETURN TRUE
END OpenFile;
BEGIN
(* Jetzt normal bearbeiten *)
INC(anz); (* Wieder ein Schreibversuch.. *)
INC(anz2); (* Wieder ein Schreibversuch.. *)
IF LENGTH(name) > 10 THEN
INC(not); (* Diese Msg wurde nicht angenommen *)
INC(not2); (* Diese Msg wurde nicht angenommen *)
ErrorWrite('Name zu lang: ');
ErrorWrite(name);
ErrorLn();
ELSE
mess.whatsThere := data.stringSet{data.bId, data.bTextDatei};
mess.pId := ADR(id);
Messages.GetHdrInfos (mscrap, refId, to, wegen, EZeile, rId);
IF (refId # NIL) & (refId^[0] # '')
THEN
INCL(mess.whatsThere, data.bRefNr);
mess.pRefNr := ADDRESS(refId);
END;
IF (rId # NIL) & (rId^[0] # '')
THEN
INCL(mess.whatsThere, data.bRId);
mess.pRId := ADDRESS(rId);
END;
IF (to # NIL) & (to^[0] # '')
THEN
INCL(mess.whatsThere, data.bAn);
mess.pAn := ADDRESS(to);
END;
IF (wegen # NIL) & (wegen^[0] # '')
THEN
INCL(mess.whatsThere, data.bWegen);
mess.pWegen := ADDRESS(wegen);
END;
IF (EZeile # NIL) & (EZeile^[0] # '')
THEN
INCL(mess.whatsThere, data.bEZeit);
mess.pEZeit := ADDRESS(EZeile);
END;
IF (LENGTH (longId) > 0)
THEN
INCL(mess.whatsThere, data.bMId);
mess.pMId := ADR (longId);
END;
IF OpenFile(CatTypes.textExt) THEN (* sonst wurde gemeckert *)
mess.txt := theFile;
IF abort OR ~WriteDat(mess, abort) THEN (* Nur einmal versuchen! *)
ErrorWrite('Die Datenbank hat die Nachricht ');
ErrorWrite(id);
ErrorWrite(' nicht angenommen');
ErrorLn();
INC(not);
INC(not2);
END;
mtTextfiles.CloseTextfile(theFile);
IF anz2-not2 >= spaceForOwnMess
THEN
(* Platz fr neue Nachrichten voll, DB schlieen und dann wieder ffnen
*)
CloseDat (abort, anz2-not2);
anz2 := 0;
not2 := 0;
END;
END;
END;
END InsertPersonal;
PROCEDURE Is (VAR refStr : ARRAY OF CHAR; REF testStr : ARRAY OF CHAR): BOOLEAN;
VAR l : CARDINAL;
res : BOOLEAN;
BEGIN
l := MagicStrings.Length (refStr);
res := MagicStrings.Pos (testStr, refStr, 0, TRUE) < l;
RETURN res;
END Is;
PROCEDURE checkHeadLine (line: ARRAY OF CHAR);
VAR key : CHAR;
mscrap : CatTypes.String255;
find : CARDINAL;
BEGIN
key := line[0];
MagicStrings.Delete (line, 0, 1);
CASE key OF
'T' : ErrorWrite ('MausTausch-Version vom ');
| 'V' : ErrorWrite ('Boxversion: ');
| 'B' : ErrorWrite ('Boxtyp: ');
| 'I' : ErrorWrite ('Boxname: ');
| 'D' : ErrorWrite ('Tauschdatum: ');
| 'U' : ErrorWrite ('User: ');
| 'W' : ErrorWrite ('eingestellte Zeilenlnge: ');
| 'L' : ErrorWrite ('eingestellte Seitenlnge: ');
| 'C' : IF ~MagicStrings.Equal ('', line)
THEN
ErrorWrite ("Die in der Box eingestellten Umlaute entsprechen nicht den ST-Umlauten.");
ErrorLn();
ErrorWrite ("ST-Umlaute: ");
ErrorLn();
ErrorWrite ("eingestellte Umlaute: ");
ELSE
ErrorWrite ('Umlaute: ');
END;
| 'S' : ErrorWrite ('Sortierung: '); (* Sortierung, interessiert uns nicht *) ;
ELSE
ErrorWrite (cUnknown);
ErrorWrite (key);
END;
ErrorWrite (line); ErrorLn();
END checkHeadLine;
PROCEDURE processHead();
VAR head: mtTextfiles.TEXTFILE;
BEGIN
IF ~OpenTextFile(DataPath, HeadFile, mtTextfiles.READ, logFileBuffer, head) THEN
IF ~batchProcess
THEN
MTE.InfoAlert(MTE.noFile1, HeadFile, MTE.noFile4);
END;
RETURN;
END;
REPEAT
mtTextfiles.ReadLine(head, idScrap);
mtTextfiles.ReadLn(head);
checkHeadLine (idScrap);
UNTIL mtTextfiles.EndofText(head);
mtTextfiles.CloseTextfile (head);
END processHead;
BEGIN
anz := 0;
not := 0;
anz2 := 0;
not2 := 0;
refMess := FALSE; (* = Das bezieht sich noch auf die in scrap gespeicherte ID *)
writeInf:= FALSE;
errOpen := FALSE;
datOpen := FALSE;
abort := FALSE;
refAssigned := FALSE;
v.bool := CatFiles.DeleteFile(DataPath, ErrFile);
(* #HEAD parsen, falls angekommen *)
IF headThere
THEN
processHead();
END;
IF ~OpenTextFile(DataPath, LogFile, mtTextfiles.READ, logFileBuffer, log) THEN
IF ~batchProcess
THEN
MTE.InfoAlert(MTE.noFile1, LogFile, MTE.noFile4);
END;
RETURN;
END;
readNew := TRUE;
REPEAT
IF readNew THEN
mtTextfiles.ReadChar(log, type);
mtTextfiles.ReadLine(log, idScrap);
mtTextfiles.ReadLn(log);
END;
readNew := TRUE;
CASE type OF
'!' : IF Strings.Pos ('Maximalgre berschritten', idScrap, 0) >= 0
THEN
(* Fehlermeldung rausbringen *)
maxOver := TRUE;
ErrorWrite ('Die MAUS meldet: ');
ErrorWrite (idScrap); ErrorLn();
refMess := FALSE;
refAssigned := FALSE;
END;
IF refMess & ~refAssigned THEN
IF (scrap[0] = 'G') &
((scrap[1] = '-') OR (scrap[1] = '+'))
THEN
(* Gruppenbestellung akzeptiert von der Maus *)
MagicStrings.Assign (scrap, mscrap);
MagicStrings.Delete (mscrap, 0, 2);
GroupSelect.ClearGroupChange (mscrap);
END;
ErrorWrite('Info zu Mitteilung ');
ErrorWrite(scrap); ErrorLn();
ErrorWrite(idScrap); ErrorLn();
IF refAssigned THEN refMess := FALSE END;
ELSE
IF refAssigned THEN refMess := FALSE END;
END;
| '#' : (* Modusende bzw. auch Modusanfang *)
refMess := FALSE;
IF idScrap[0] # 0C THEN
refMess := TRUE;
refAssigned := FALSE;
scrap := idScrap;
END;
| '%' : IF ~headThere
THEN
checkHeadLine (idScrap);
END;
| '=' : IF refMess THEN (* Nur dann sinnvoll *)
mscrap := scrap;
IF Messages.IsPrivateMessage (mscrap)
THEN
MagicStrings.Assign (idScrap, shortId);
(* Nchste Zeile lesen *)
mtTextfiles.ReadChar(log, type);
mtTextfiles.ReadLine(log, idScrap);
mtTextfiles.ReadLn(log);
IF (type = '!') & (idScrap [0] = '=')
THEN
(* wird wohl lange Id sein *)
(* Gleichheitszeichen lschen *)
MagicStrings.Delete (idScrap, 0, 1);
ELSE
readNew := FALSE;
END;
v.bool := OpenPers();
Messages.GetMsgFileName (scrap);
InsertPersonal (shortId, idScrap, scrap);
END;
refAssigned := ~Messages.MsgHasCopys (scrap);
Messages.DeleteMessage (mscrap);
(* refAssigned := TRUE; *)
ELSE
ErrorWrite('Hier steht ein "=" in der Landschaft,'); ErrorLn();
ErrorWrite('das ich mir nicht erklren kann : =');
ErrorWrite(idScrap); ErrorLn();
END;
| '?' : IF refMess THEN
(* :?Dupe zu #A1234@XY vom ... *)
IF Is (idScrap, isDupe)
THEN
ErrorWrite ('Maus meldet Dupe bei Mitteilung: ');
ErrorWrite (scrap); ErrorLn();
mscrap := scrap;
IF Messages.IsPrivateMessage (mscrap) &
OpenPers()
THEN
(* Prfen, ob schon in Datenbank eingefgt *)
find := MagicStrings.Pos ('#', idScrap, 0, FALSE);
MagicStrings.Delete (idScrap, 0, find+1);
find := MagicStrings.Pos (' ', idScrap, 0, FALSE);
MagicStrings.Delete (idScrap, find, MagicStrings.Length (idScrap) - find);
(* Jetzt steht in idScrap die ID von der Maus *)
v.card := data.NumberOfID(dat, idScrap);
IF data.error = data.notFound
THEN
ErrorWrite ('Nachricht wird eingefgt');
ErrorLn();
Messages.GetMsgFileName (scrap);
MagicStrings.Assign ("", shortId);
InsertPersonal (idScrap, shortId, scrap);
ELSE
ErrorWrite ('Nachricht wird nicht eingefgt, ist schon da.');
ErrorLn();
END;
ELSE
ErrorWrite ('Nachricht ist ffentliche Nachricht, wird nicht eingefgt');
ErrorLn();
END;
Messages.DeleteMessage (mscrap);
ELSIF Is (idScrap, refNotFound)
THEN
(* ?Mitteilung "P17165@LU" nicht gefunden *)
ErrorWrite ('Maus kennt Referenznachricht nicht bei Mitteilung: ');
ErrorWrite (scrap); ErrorLn();
(* Jetzt einfach dem Messagemanager sagen, er soll aus der
* Nachricht eine neue machen ohne Verkettung
*)
IF Messages.ChangeMessage (scrap)
THEN
ErrorWrite ('Die Nachricht wird "Wildwest"-verkettet');
ErrorLn();
ELSE
ErrorWrite ('Die Nachricht wird gelscht');
ErrorLn();
Messages.DeleteMessage (scrap);
END;
ELSE
ErrorWrite('Maus meldet Fehler bei Mitteilung: ');
ErrorWrite(scrap); ErrorLn();
END;
refAssigned := TRUE;
ELSE
ErrorWrite('Fehlermeldung der Maus: ');
ErrorWrite(idScrap);ErrorLn();
END;
| '"' : refMess := TRUE; scrap := idScrap; refAssigned := FALSE;
find := MagicStrings.Pos ('"', scrap, 0, FALSE);
IF find < LENGTH (scrap) THEN
(* zweites Anfhrungszeichen entfernen *)
MagicStrings.Delete (scrap, find, 1);
END;
| '$' : find := MagicStrings.Pos ('=', idScrap, 0, FALSE);
refMess := FALSE;
(* Kennung rauskopieren *)
IF find < (*SYSTEM.*)LENGTH(idScrap)
THEN
(* Gleichheitszeichen gefunden, Infofilenamen nach mscrap kopieren *)
MagicStrings.Copy (idScrap, 0, find, mscrap);
find2 := MagicStrings.Pos(' ', idScrap, find, FALSE);
IF find2 < (*SYSTEM.*)LENGTH(idScrap) THEN
idScrap[find2] := 0C;
MagicStrings.Copy(idScrap, find+1, find2-find-1, idScrap);
IF ~writeInf THEN LoadInfoInf(FALSE, TRUE); writeInf := TRUE END;
MagicStrings.Assign (idScrap, idScrap);
SetInfoCrc(mscrap, idScrap);
END;
ELSE
(* Mglicherweise Jedesmal-Infofile *)
find := MagicStrings.Pos (' ', idScrap, 0, FALSE);
IF find < (*SYSTEM.*)LENGTH(idScrap)
THEN
MagicStrings.Copy (idScrap, 0, find, mscrap);
IF ~writeInf THEN LoadInfoInf(FALSE, TRUE); writeInf := TRUE END;
MagicStrings.Assign ('0', idScrap);
SetInfoCrc(mscrap, idScrap);
END;
END;
(*
IF isOneInf(idScrap, which, '=') THEN
find := MagicStrings.Pos(' ', idScrap, 0, FALSE);
IF find < LENGTH(idScrap) THEN
idScrap[find] := 0C;
MagicStrings.Copy(idScrap, 4, find-4, idScrap);
IF ~writeInf THEN LoadInfoInf(FALSE, TRUE); writeInf := TRUE END;
SetInfoCrc(which, idScrap);
END;
ELSE
ErrorWrite('Unbekanntes Infofile der Maus: ');
ErrorWrite(idScrap); ErrorLn();
END;
*)
| ELSE
ErrorWrite(cUnknown);
ErrorWrite(idScrap);
ErrorLn()
END;
gotId := (type = '=') & refMess;
UNTIL mtTextfiles.EndofText(log);
IF UserBLK.statusToIn & ~CatFiles.DeleteFile(MessagePath, CatTypes.statusInf) THEN
ErrorWrite(CatTypes.statusInf); ErrorWrite(notDeleted); ErrorLn();
END;
IF UserBLK.groupChangeToIn & ~CatFiles.DeleteFile(MessagePath, CatTypes.grSelect) THEN
ErrorWrite(CatTypes.grSelect); ErrorWrite(notDeleted); ErrorLn();
END;
v.bool := CatFiles.DeleteFile (MessagePath, CatTypes.userCmdFile);
CloseDat(abort, anz-not);
ErrorClose();
IF writeInf THEN SaveInfoInf(); END;
mtTextfiles.CloseTextfile(log);
IF anz > 0 THEN (* Nur falls mind. eine versucht wurde zu schreiben *)
CatLog.putTime();
CatLog.WriteCard(anz-not);
CatLog.WriteString(' von ');
CatLog.WriteCard(anz);
CatLog.WriteKonjString (cMessStr,'',cExtStr, anz);
CatLog.WriteLine(cImpStr);
CatLog.WriteString(cSpace9Str);
CatLog.WriteCard(not);
CatLog.WriteKonjString (cMessStr,'',cExtStr,not);
CatLog.WriteLine(' wegen eines Fehlers oder vom Datenbankmodul abgelehnt');
END;
END processLog;
(*-------------------------------------------------------------------------*)
PROCEDURE OutfileOk(handle : INTEGER; VAR len : LONGCARD):BOOLEAN;
(* Testet anhand einiger Kleinigkeiten, ob dies ein Outfile ist, nicht *)
(* 100% sicher, aber immerhin werden die ganz schlimmen Flle damit *)
(* erkannt; Attention: may be critical if MAUS changes textfile-format! *)
VAR c : CHAR;
BEGIN
len := MagicDOS.Fseek(0, handle, MagicDOS.SeekEnd);
v.lcard := MagicDOS.Fseek(0, handle, MagicDOS.SeekStart);
IF len < 6 THEN RETURN FALSE
ELSE
CatFiles.ReadFile(c, handle);
IF (c # '#') OR (CatFiles.FileError < 0) THEN RETURN FALSE END;
CatFiles.Seek(-5, handle, CatFiles.end);
CatFiles.ReadFile(c, handle);
IF (c # CR) OR (CatFiles.FileError < 0) THEN RETURN FALSE END;
CatFiles.ReadFile(c, handle);
IF (c # LF) OR (CatFiles.FileError < 0) THEN RETURN FALSE END;
CatFiles.ReadFile(c, handle);
IF (c # '#') OR (CatFiles.FileError < 0) THEN RETURN FALSE END;
CatFiles.ReadFile(c, handle);
IF (c # CR) OR (CatFiles.FileError < 0) THEN RETURN FALSE END;
CatFiles.ReadFile(c, handle);
IF (c # LF) OR (CatFiles.FileError < 0) THEN RETURN FALSE END;
RETURN TRUE
END
END OutfileOk;
(*-------------------------------------------------------------------------*)
PROCEDURE OutfileVorbereiten(doDeArc, txtIsThere : BOOLEAN;
VAR handle : INTEGER;
VAR length : LONGCARD):BOOLEAN;
(* Outfile fr das Einfgen vorbereiten, d.h. ntigenfalls auspacken, *)
(* weiterhin ffnen und testen, ob es ok ist; Liefert direkt den Zugriffs- *)
(* handle und Lnge, falls alles geklappt hat *)
(* Diese Prozedur wird immer mit gesetztem WindUpdate aufgerufen, fr *)
(* lngere Aktionen sollte daher der Bildschirm freigegeben werden *)
VAR space : LONGCARD;
disk : MagicDOS.DISKINFO;
packret : INTEGER;
BEGIN
IF doDeArc THEN
IF txtIsThere THEN
IF batchProcess OR (mtAlerts.Alert(1, MTE.outOverwrite) = 1) THEN
IF ~CatFiles.DeleteFile(ImportPath, OutfileTxt) THEN
CatFiles.ErrorAlert(MagicDOS.EAccDn);
CatLog.WriteLineNTime(cOfNdel);
CatLog.CloseLog();
RETURN FALSE
ELSE
CatLog.WriteLineNTime(cOfDel);
END
ELSE
CatLog.WriteLineNTime('Einfgen abgebrochen durch User');
CatLog.CloseLog();
RETURN FALSE
END
END;
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
END;
CatLog.WriteLineNTime('Outfile auspacken');
ConfVars.GetConfDefBool (cRedirectToLog, v.bool, FALSE);
packret := ARCStarter.DeArc (v.bool);
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
END;
IF packret # 0 THEN
(* Outfile auspacken, DeArc mu die Fehlermeldungen bringen! *)
CatLog.putTime();
CatLog.WriteString('Fehler beim Auspacken, GEMDOS-Fehler Nr. ');
CatLog.WriteInt (packret);
CatLog.WriteLn;
MTE.warnAlert(~batchProcess, MTE.noDearc, '', '');
RETURN FALSE
ELSE
CatLog.WriteLineNTime('Outfile ausgepackt');
CatLog.WriteLn();
END;
(*
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
MagicAES.EvntTimer (200);
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
*)
ELSE
handle := CatFiles.OpenFile(ImportPath, OutfileTxt, CatFiles.readFile);
IF CatFiles.FileError = MagicDOS.EFilNF THEN (* File nicht gefunden? *)
CatLog.WriteLineNTime('Outfile-Text nicht gefunden');
MTE.warnAlert(~batchProcess, MTE.outNotFound, '', '');
RETURN FALSE
END;
CatFiles.CloseFile(handle);
END;
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
END;
(* Hier werden jetzt die IO-Filter aufgerufen *)
IF ~IoFilter.IoFilterOutfile()
THEN
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
END;
RETURN FALSE;
END;
Messages.ReReadMessageInfo();
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
END;
handle := CatFiles.OpenFile(ImportPath, OutfileTxt, CatFiles.readFile);
(* CloseFile durch OutfileOk! *)
IF CatFiles.FileError = MagicDOS.EFilNF THEN (* File nicht gefunden? *)
CatLog.WriteLineNTime('Outfile-Text nicht gefunden');
MTE.warnAlert(~batchProcess, MTE.outNotFound, '', '');
RETURN FALSE
ELSIF CatFiles.FileError < 0 THEN (* allgemeiner Fehler *)
CatLog.WriteLineNTime('Dateifehler beim ffnen von Outfile-Text');
CatFiles.ErrorAlert(CatFiles.FileError);
RETURN FALSE
ELSIF ~OutfileOk(handle, length) THEN
(* length enthlt Lnge des Outfiles *)
CatFiles.CloseFile(handle);
CatLog.WriteLineNTime('Defektes Outfile festgestellt');
MTE.warnAlert(~batchProcess, MTE.wrongOut, '', '');
RETURN FALSE
ELSE
(* erst hier ist sicher, da OUTFILE.TXT 'ok' ist, also OutfileOk passiert *)
(* hat *)
CatLog.WriteLineNTime('Outfile geffnet und getestet');
IF doDeArc & UserBLK.DeleteAfterDecode THEN
IF ~CatFiles.DeleteFile(ImportPath, archiveName) THEN
CatFiles.ErrorAlert(MagicDOS.EAccDn);
CatLog.WriteLineNTime('Fehler beim Lschen des Outfile-Archivs');
ELSE
CatLog.WriteLineNTime('Outfile-Archiv gelscht nach auspacken');
END;
END;
(* MagicDOS.Dfree(disk, ORD(CAP(DataPath[0])) - ORD('A') + 1); *)
CatGlobal.PathFree (disk, DataPath);
space := disk.bSecsiz * disk.bClsiz * disk.bFree;
IF space < length + secureBytes THEN
CatFiles.CloseFile(handle);
CatLog.WriteLineNTime('Zuwenig Diskplatz festgestellt');
MTE.warnAlert(~batchProcess, MTE.diskSpace, '', '');
RETURN FALSE
END
END;
RETURN TRUE;
END OutfileVorbereiten;
(*------ Einlagern --------------------------------------------------------*)
PROCEDURE InitList(gPos : onePosArrayPtr;
VAR gMax,
gStart : oneMaxArray;
VAR maxPos : CARDINAL); (* initialisiert die Gruppenliste *)
VAR z : CARDINAL;
BEGIN
maxPos := 0; (* nchste zu belegende Position *)
FOR z := 0 TO maxGroup DO
gMax[z] := EndOfList; (* Listenschwnze *)
gStart[z] := EndOfList; (* Listenkpfe *)
END;
FOR z := 0 TO maxArray DO
gPos^[z].next := EndOfList;
END;
groupsUsed := oneGroupSet{};
END InitList;
PROCEDURE AppendToListNr(gPos : onePosArrayPtr; (* Positionsinformation *)
VAR gMax, (* Listenenden *)
gStart: oneMaxArray; (* Listenkpfe *)
VAR maxPos: CARDINAL; (* max. Position in gPos *)
count : LONGCARD; nr : CARDINAL);
(* hngt die Msg, die bei <count> beginnt, an die Gruppenliste <nr> an *)
BEGIN
INCL (groupsUsed, nr);
IF gStart[nr] = EndOfList THEN (* Noch keine Msg dieser Gruppe gefunden *)
gStart[nr] := maxPos; (* Dort kommt der erste Eintrag hin *)
ELSE
WITH gPos^[gMax[nr]] DO (* letztes belegtes Element dieser Gruppe *)
next := maxPos;
END;
END;
gMax[nr] := maxPos; (* nchstes zu belegendes Arrayelement *)
WITH gPos^[gMax[nr]] DO
next := EndOfList;
offset := count;
END;
INC(maxPos); (* wieder nchstes zu belegende Element *)
(* Ende erreicht, wenn maxPos > maxArray, mu unten in der Schleife *)
(* festgestellt werden *)
END AppendToListNr;
PROCEDURE AppendToList(gPos : onePosArrayPtr;
VAR gMax,
gStart : oneMaxArray;
VAR maxPos : CARDINAL;
count : LONGCARD;
gruppe : ARRAY OF CHAR):BOOLEAN;
(* hngt die Msg, die bei <count> beginnt, an die entsprechende *)
(* Gruppenliste an. Sucht in der Namensliste der Gruppen nach dem String *)
(* <gruppe> <sonstige> werden auch sortiert, dazu wird die Liste erweitert *)
VAR z : CARDINAL; found : BOOLEAN;
BEGIN
(*
MagicStrings.CAPS(gruppe);
*)
IF ~GroupSelect.GroupNumber(gruppe, z) & ~GroupSelect.AppendGroup(gruppe) THEN
RETURN FALSE
END;
AppendToListNr(gPos, gMax, gStart, maxPos, count, z);
RETURN TRUE
END AppendToList;
(*------ Auslesen ---------------------------------------------------------*)
PROCEDURE ReadNextElement(gPos : onePosArrayPtr;
VAR l : LONGCARD;
VAR next : CARDINAL):BOOLEAN;
(* Wegen next nicht verwirren lassen, erst steht dort der Arrayindes *)
(* ("Pointer") der aktuellen Msg, anschlieend kommt der nchste dort *)
(* hinein *)
BEGIN
next := gPos^[next].next;
IF next = EndOfList THEN
RETURN FALSE
ELSE
l := gPos^[next].offset;
RETURN TRUE
END;
END ReadNextElement;
(*--------- Sortierung ----------------------------------------------------*)
PROCEDURE ReadMemLine(VAR count : LONGCARD;
VAR str : ARRAY OF CHAR;
oPtr : CatTypes.LargeTextPtr;
oAnz : LONGCARD);
(* liest eine Zeile aus dem Speicher bis zum CR/LF in <str> ein. CR wird *)
(* durch ein 0C ersetzt und LF wird bersprungen *)
(* *)
(* vor dem Aufruf mu mittels CheckMemLine und anschlieendem Test *)
(* festgestellt worden sein, da die Zeile auch komplett im Puffer ist *)
VAR z : LONGCARD;
BEGIN
(*
z := 0;
WHILE (z < LONG(HIGH(str))) & (oPtr^[count+z] # CR) DO
str[SHORT(z)] := oPtr^[count+z];
INC(z)
END;
str[SHORT(z)] := 0C;
(* Die folgende Schleife erledigt auch das Problem, wenn die letzte *)
(* Schleife durch HIGH abgebrochen wurde *)
WHILE oPtr^[count+z] # LF DO
INC(z)
END;
INC(count, z+1); (* +1 wg. nchster zu bearbeitender Buchstabe *)
*)
ASSEMBLER
MOVE.L count(A6),A0
MOVE.L (A0),D0 ; count nach D0, Adresse in A0
MOVE.L str(A6),A1 ; ADR(str) nach A1
MOVE.W str+4(A6),D1 ; High(Str) nach D1
EXT.L D1 ; auf Long expandieren
MOVE.L oPtr(A6),A2 ; oPtr nach A2
MOVEQ #0,D2 ; z auf 0
ADDA.L D0,A2 ; oPtr^[count+z] in A2
loop:
CMP.L D2,D1 ; z < HIGH (str)
BLT.S endloop ; z ist grer gleich, branch
CMPI.B #CR,(A2) ; oPtr^[count+z] # CR
BEQ.S endloop ; ist CR, raus
MOVE.B (A2)+,(A1)+ ; str[z] := oPtr^[count+z];
ADDQ.L #1,D2
BRA.S loop
endloop:
MOVE.B #0,(A1) ; str[z] := 0c
loop2:
CMPI.B #LF,(A2)+ ; oPtr^[count+z] # LF
BEQ.S endl2
ADDQ.L #1,D2 ; INC (z);
BRA.S loop2
endl2:
ADDQ.L #1,D2 ; INC (count, z+1);
ADD.L D2,D0
MOVE.L D0,(A0) ; count zurckschreiben
END;
(*
CALLSYS (1, 4201, CADR ("ReadMemLine exit: Count: %ld"), count);
*)
END ReadMemLine;
PROCEDURE CheckMemLine(VAR count : LONGCARD;
oPtr : CatTypes.LargeTextPtr;
oAnz : LONGCARD);
(* durchsucht den Speicher bis zum CR/LF *)
BEGIN
(*
WHILE (count < oAnz) & (oPtr^[count] # LF) DO
INC(count)
END;
(* jetzt entweder am Ende oder auf dem LF *)
(* LF berspringen, fr den anderen Fall schadet es auch nicht *)
IF (count < oAnz)
THEN
INC(count);
END;
*)
ASSEMBLER
MOVE.L count(A6),A0
MOVE.L (A0),D0 ; count
MOVE.L oAnz(A6),D1 ; oAnz
MOVE.L oPtr(A6),A1 ; Textadresse
ADDA.L D0,A1 ; oPtr^[count] in A1
loop:
CMP.L D0,D1 ; count < oAnz
BLE.S endloop ; count ist grer
CMPI.B #LF,(A1)+ ; oPtr^[count] # LF
BEQ.S endloop
ADDQ.L #1,D0 ; INC (count)
BRA.S loop ; und looping
endloop:
ADDQ.L #1,D0 ; INC (count);
MOVE.L D0,(A0) ; Variable zurckschreiben
END;
(*
CALLSYS (1, 4201, CADR ("CheckMemLine exit: Count: %ld"), count);
*)
(* LF berspringen, fr den anderen Fall schadet es auch nicht *)
END CheckMemLine;
PROCEDURE HandleMessage(gPos : onePosArrayPtr;
VAR gMax,
gStart : oneMaxArray;
VAR TxtOut : mtTextfiles.TEXTFILE;
VAR TxtOutOpen : BOOLEAN;
VAR TxtName: ARRAY OF CHAR;
VAR maxPos : CARDINAL;
VAR count : LONGCARD;
VAR text : CARDINAL;
VAR unknown: CARDINAL;
oPtr : CatTypes.LargeTextPtr;
oAnz : LONGCARD):BOOLEAN;
(* Geht zunchst von <count> an aufwrts durch, bis ein CR/LF/'G' od. *)
(* ':','>','#' gefunden wird. Wenn ein 'G' gefunden wird, dann wird die *)
(* Msg an die Liste fr die entsprechende Gruppe angehngt.Falls die *)
(* letzte Zeichenfolge nicht CR/LF/'#' war, dann wird bis zum Erreichen *)
(* dieser Folge weitergesucht. *)
(* <count> zeigt immer auf den nchsten zu bearbeitenden Buchstaben *)
(* *)
(* Returniert FALSE, wenn eine Mitteilung abbricht und eine Speicher- *)
(* verschiebung ntig wird *)
(* *)
(* Wenn TxtOutOpen TRUE ist dann mu noch eine Infodatei geschrieben *)
(* werden; bis zu ihrem Ende *)
VAR str,
str2 : CatTypes.String1023;
tmp : LONGCARD;
tmp2 : LONGCARD;
old : LONGCARD;
isGroup : BOOLEAN;
ptr : CatTypes.Str255Ptr;
endLoop : BOOLEAN;
isInfo : BOOLEAN;
infLen : INTEGER;
strType : NrTypes;
i : INTEGER;
BEGIN
(* Textfiles, d.h. Maus-Infofiles und das Logfile werden separat behandelt *)
(* Ende der Zeile suchen, Index steht danach in tmp *)
tmp := count;
CheckMemLine (tmp, oPtr, oAnz);
IF tmp >= oAnz
THEN
(*
(* Zeile nicht mehr im Buffer, direkt wieder raus *)
CatLog.WriteString ("Broken Id at beginnig of block");
CatLog.WriteLn;
*)
DEC (count);
RETURN FALSE;
END;
ptr := ADR(oPtr^[count]); (* Fr den Zugriff gleich *)
isInfo := FALSE;
IF ~TxtOutOpen THEN
strType := typeOf (ptr^);
isInfo := isOneInf (ptr^, infLen);
(*
i := 0;
WHILE ((i< 255) & (ptr^[i] # CR)) DO
str[i] := ptr^[i];
INC(i);
END;
str[i] := '';
CatLog.WriteString ("Handling Id: ");
CatLog.WriteString (str);
CatLog.WriteLn;
*)
END;
IF TxtOutOpen OR
isInfo OR
isUnknownInf (ptr^, infLen)
(*
(strType = REN) OR
(strType = HEAD) OR
(strType = LOG) OR
*)
THEN
(* Hier wird sich auf die Reihenfolge der Abarbeitung verlassen *)
(* Wenn TxtOut # NIL, dann ist schon eine Textdatei offen und sie mu *)
(* noch auf die Platte geschrieben werden, da sie beim letzten Mal *)
(* nicht komplett im Puffer war. *)
(* !! Wenn ein Infotext abbricht, dann kann es nur am Ende sein *)
IF ~TxtOutOpen THEN (* Noch keine Datei offen, jetzt Namen erstellen *)
IF (strType = LOG) OR (strType = REN)
THEN
infLen := 3;
ELSIF (strType = HEAD)
THEN
infLen := 4;
headThere := TRUE;
END;
MagicStrings.Copy(ptr^, 0, infLen, str);
IF ~isInfo & isUnknownInf (ptr^, infLen)
& ((strType = nottich) OR (strType = normal))
THEN
INC (unknown);
CatLog.WriteLn();
CatLog.WriteStringNTime ('Unbekannter Infotext im Outfile: ');
CatLog.WriteString (str);
END;
MagicStrings.Assign (str, TxtName);
MagicStrings.Append('.txt', str);
MagicStrings.Assign (DataPath, str2);
MagicStrings.Append (str, str2);
IF ~(ConfVars.GetConfigBool (cNoInfoBackups, v.bool) & v.bool)
THEN
(* Nur beim ersten Mal ein Backup von #LOG anlegen! *)
IF ((strType = LOG) & ~firstLog) OR
(strType # LOG)
THEN
v.bool := CatGlobal.CreateBackup (str2);
END;
END;
IF strType = LOG
THEN
TxtOutOpen := OpenTextFile(DataPath, str, mtTextfiles.APPEND,
infoFileBuffer, TxtOut);
IF ~TxtOutOpen
THEN
TxtOutOpen := OpenTextFile(DataPath, str, mtTextfiles.WRITE,
infoFileBuffer, TxtOut);
END;
firstLog := TRUE;
ELSE
TxtOutOpen := OpenTextFile(DataPath, str, mtTextfiles.WRITE,
infoFileBuffer, TxtOut);
END;
MTE.warnAlert(~TxtOutOpen, MTE.noFile1, str, MTE.noFile3);
CheckMemLine(count, oPtr, oAnz); (* #LOG u.. berspringen *)
INC(text); (* ein weiterer Text ist gekommen *)
ELSE
(* d.h. das Textfile ist schon offen, es liegt ein Wechsel des *)
(* Puffers vor, da beim alten das Ende berschritten wurde. *)
END;
old := count; (* Mitzhlen, fr die Anzeige unten *)
(* Hier gilt folgendes: Wir sind entweder am Anfang des Infofiles
* oder mittendrin. oPtr^[count] zeigt auf das erste Zeichen einer
* Zeile, d.h. auf einen ':' oder ein '#' (z.b. bei leeren Infofiles)
* Wir kopieren nun zeilenweise alles in die Textdatei, count zeigt
* dabei *immer* auf den Anfang der Zeile!
*)
tmp := count; (* tmp ist der temporre Zhler. *)
WHILE (oPtr^[count] # '#') & (tmp < oAnz) DO
IF oPtr^[count] = ':'
THEN
INC (tmp); (* ':' berspringen *)
END;
tmp2 := tmp;
(* Ende der Zeile suchen, Index steht danach in tmp *)
CheckMemLine (tmp, oPtr, oAnz);
IF tmp < oAnz
THEN
(* Zeile ist noch im aktuellen Buffer, tmp zeigt aufs Ende,
* tmp2 auf Anfang!
*)
ReadMemLine (tmp2, str, oPtr, oAnz);
IF TxtOutOpen THEN (* Nur schreiben, wenn das ffnen geklappt hat *)
mtTextfiles.WriteLine(TxtOut, str);
mtTextfiles.WriteLn(TxtOut);
END;
(* count auf Anfang der nchsten Zeile zeigen lassen
*)
count := tmp2;
END;
END;
(* Entweder sind wir am Ende des Infofiles oder der Buffer ist am Ende
*)
showImport.SetNew(count-old);
CatGlobal.busyMouse();
IF tmp >= oAnz THEN (* alle Zeichen im Puffer behandelt; kein Ende *)
(* Was mu man hier machen? Erstmal jedenfalls nichts *)
RETURN FALSE; (* !!! Hier broken zurckgeben! *)
ELSE
INC(count); (* '#' berspringen *)
IF TxtOutOpen THEN
mtTextfiles.CloseTextfile(TxtOut); (* Alles drin *)
TxtOutOpen := FALSE; (* entwerten.. *)
(* Jetzt eventuell direkt parsen, falls ntig *)
TestDirectParse (TxtName);
MagicStrings.Assign ('', TxtName);
END;
END;
ELSE (* es ist eine Msg oder Statusmeldung *)
isGroup := FALSE; (* kein 'G' gefunden *)
old := count; (* jetzige Pos merken *)
REPEAT
REPEAT (* Mal alle Zeilen durchrappeln.. *)
CheckMemLine(count, oPtr, oAnz)
UNTIL (oPtr^[count] = 'G') OR (oPtr^[count] = '#') OR (count >= oAnz);
(* ..bis zum Ende oder zur Gruppenangabe *)
IF (oPtr^[count] = 'G') & (count < oAnz) THEN (* Gruppe gefunden? *)
INC(count); (* 'G' berspringen *)
ReadMemLine(count, str, oPtr, oAnz); (* dann mal lesen.. *)
isGroup := TRUE;
END;
UNTIL (oPtr^[count] = '#') OR (count >= oAnz);
(* Erstmal weitermachen bis zum Mitteilungsende *)
IF count < oAnz THEN
INC(count); (* '#' berspringen *)
IF isGroup THEN
(*CatLog.WriteString('pos:');CatLog.WriteCard(count);CatLog.WriteLn(); *)
RETURN AppendToList(gPos, gMax, gStart, maxPos, old, str);
(* mal gucken, wo's hingehrt *)
ELSE (* Ist persnlich! *)
AppendToListNr(gPos, gMax, gStart, maxPos, old, dataSys.private);
END;
ELSE
(* Mitteilung bricht ab, Berechnung des zu verschiebenden Speichers *)
count := old-1; (* Sollte in jedem Fall auf den Anfang der ID zeigen *)
(*CatLog.WriteString('pos:');CatLog.WriteCard(count);CatLog.WriteLn(); *)
RETURN FALSE
END;
END;
(*CatLog.WriteString('pos:');CatLog.WriteCard(count);CatLog.WriteLn(); *)
RETURN TRUE
END HandleMessage;
(*--- Flagzeile prfen und Flags ggf. vorbesetzen ---------------------------*)
PROCEDURE CheckFlagLine (str: CatTypes.Str255Ptr; VAR bitWhishes : BITSET);
(*
Die Definition der Zeile im Outfile ist:
Krzel: s (Achtung, klein)
G Gelesen (Nicht gelesen entspricht G-)
X Totallschung
F Interessant (entspricht wohl fixieren bei anderen)
L Gefiltert
V Vererben
D Teillschung
K Kommentieren
B Beantworten
C Echt gut (genauer: Userflag 1, Name frei konfigurierbar)
M Echt Mist (genauer: Userflag 2, Name frei konfigurierbar)
G, X und F mssen, sofern vorhanden, am Anfang stehen.
~~~
*)
PROCEDURE CheckFlag (ch : CHAR; bit: INTEGER; VAR bits: BITSET);
BEGIN
IF ch = CAP(ch) THEN INCL (bits, bit);
ELSE EXCL (bits, bit);
END;
END CheckFlag;
VAR idx: INTEGER;
BEGIN
idx := 0;
WHILE (idx < 254) & (ORD(str^[idx]) >= 32) DO
CASE str^[idx] OF
'B' : CheckFlag (str^[idx], dataSys.bAntworten, bitWhishes); |
'C' : CheckFlag (str^[idx], dataSys.bUser1, bitWhishes); |
'D' : CheckFlag (str^[idx], dataSys.bTeilloeschung, bitWhishes); |
'F' : CheckFlag (str^[idx], dataSys.bInteressant, bitWhishes); |
'G' : CheckFlag (str^[idx], dataSys.bGelesen, bitWhishes); |
'K' : CheckFlag (str^[idx], dataSys.bKommentieren, bitWhishes); |
'L' : CheckFlag (str^[idx], dataSys.bFiltered, bitWhishes);
IF (dataSys.bFiltered IN bitWhishes) & filteredToRead
THEN
INCL(bitWhishes, dataSys.bGelesen);
END; |
'M' : CheckFlag (str^[idx], dataSys.bUser2, bitWhishes); |
'V' : CheckFlag (str^[idx], dataSys.bVererben, bitWhishes); |
'X' : CheckFlag (str^[idx], dataSys.bTotalloeschung, bitWhishes); |
ELSE
END;
INC (idx);
END;
END CheckFlagLine;
(*--- Ausgabe ---------------------------------------------------------------*)
PROCEDURE HandleEvents ();
VAR z : CARDINAL;
mBuff: ARRAY [0..15] OF INTEGER;
dr : RECORD
CASE :BOOLEAN OF
TRUE : x,y,w,h : INTEGER|
FALSE: adr, dum: ADDRESS
END
END;
event,
evnt : BITSET;
doExit : BOOLEAN;
moX, moY : INTEGER;
moButton : BITSET;
kReturn : INTEGER;
moKState : BITSET;
bReturn : INTEGER;
scan : INTEGER;
sc,
ch : CHAR;
BEGIN
IF CatGlobal.multiTask
THEN
(* Hier bei MultiTasking noch eine kleiner EventMulti und ein paar
* Events verarbeiten
*)
LOOP
evnt := MagicAES.EvntMulti(
{MagicAES.MUMESAG, MagicAES.MUTIMER},
0,{},{}, 0,dr, 0, dr, mBuff, 0, 0,
moX, moY, moButton, kReturn, moKState, scan, ch, bReturn);
(* Den Timerevent brauchen wir nicht *)
event := evnt;
doExit := evnt = BITSET{MagicAES.MUTIMER};
EXCL (event, MagicAES.MUTIMER);
doExit := event = BITSET{};
sc := CHAR(SHORT(scan));
v.bool := WdwManager.HandleEvent (evnt, mBuff, moButton, moKState, ch, sc, kReturn, moX, moY, bReturn);
(* Jetzt die Kopie abfragen *)
IF doExit THEN EXIT END;
END;
END;
END HandleEvents;
PROCEDURE WriteBufferedOutfile(oPtr : CatTypes.LargeTextPtr;
oAnz : LONGCARD;
checkOwn : BOOLEAN;
ownName : ARRAY OF CHAR;
REF gPos : onePosArrayPtr;
REF gStart : oneMaxArray;
VAR gNot, gWatch, gAnz, gGarbage, gStatus, pmNot, gDupeCount : CARDINAL;
VAR USENETCHAIN, USENETOK : CARDINAL;
VAR abort : BOOLEAN);
(* gibt nacheinander alle in der Gruppenliste gespeicherten Msg an data *)
(* weiter (ber WriteMessage) *)
(* Bricht bei Fehlermeldung von data ab *)
(* Geht davon aus, da die behandelte Msg komplett im Speicher steht, *)
(* wovon man nach Kai's Doku bei der jetzigen Puffergre ausgehen darf *)
VAR not, watch, anz, garbage, status, dupeCount : CARDINAL;
(* Anzahl der Einfgeversuche/Ablehnungen/watchDogs/Fehlermails *)
PROCEDURE WriteOneGroup(gruppe : CARDINAL;
checkOwn : BOOLEAN;
ownName : ARRAY OF CHAR;
VAR not, watch, anz, garbage, status, dupeCount : CARDINAL;
VAR USENETCHAIN, USENETOK : CARDINAL;
VAR abort : BOOLEAN):BOOLEAN;
(* gibt den Inhalt einer Gruppe aus *)
VAR handle : data.OneGroupHandle; (* Zugriffshandle fr die Datenbank *)
PROCEDURE WriteOneMsg(gruppe : CARDINAL; MessStart : LONGCARD;
checkown : BOOLEAN; ownName : ARRAY OF CHAR;
VAR USENETCHAIN, USENETOK : CARDINAL;
VAR isDupe: BOOLEAN;
VAR abort : BOOLEAN):BOOLEAN;
(* Gibt eine Gruppe aus; Rckgabewert ist, der Wert von MTDataBase *)
VAR count,
old,
start : LONGCARD;
toData : data.PtrRecord;
helpPtr : CatTypes.Str1023Ptr;
what : data.WhatsThat;
PROCEDURE DeflectorShieldsStrongEnough(VAR mess : data.PtrRecord; what : data.WhatsThat; VAR bitWhishes : BITSET):BOOLEAN;
(* Look, if the deflector-shields of CAT are hard enough to deflect incoming *)
(* enemy message *)
VAR DogsOpinion : Protokoll.watchType;
BEGIN
IF what # data.normal THEN RETURN FALSE END;
(* user-aided external deflector-shield *)
(* phasers locked on target *)
IF mess.pGruppe # NIL THEN DEC(mess.pGruppe); END; (* Freundlichkeit fr WatchDog *)
IF mess.pWegen # NIL THEN DEC(mess.pWegen); END; (* Freundlichkeit fr WatchDog *)
IF mess.pVon # NIL THEN DEC(mess.pVon); END; (* Freundlichkeit fr WatchDog *)
IF CatGlobal.multiTask THEN MagicAES.WindUpdate (MagicAES.BEGUPDATE); END;
DogsOpinion := Protokoll.AcceptThis(mess);
IF CatGlobal.multiTask THEN MagicAES.WindUpdate (MagicAES.ENDUPDATE); END;
IF (DogsOpinion = Protokoll.pCatForget) OR (DogsOpinion = Protokoll.pCatFiltered) THEN
CatLog.WriteStringNTime('Nachricht ');
CatLog.WriteString(mess.pId^);
IF DogsOpinion = Protokoll.pCatForget THEN
CatLog.WriteLine(' von WatchDog abgelehnt.');
(* Scotty, energy *)
RETURN TRUE; (* user-aided deflection succeded *)
ELSIF DogsOpinion = Protokoll.pCatFiltered THEN
CatLog.WriteLine(' vom WatchDog als gefiltert markiert');
INCL(bitWhishes, dataSys.bFiltered);
IF filteredToRead
THEN
INCL(bitWhishes, dataSys.bGelesen);
END;
END;
END;
IF mess.pGruppe # NIL THEN INC(mess.pGruppe); END; (* Freundlichkeit fr CAT *)
IF mess.pWegen # NIL THEN INC(mess.pWegen); END; (* Freundlichkeit fr CAT *)
IF mess.pVon # NIL THEN INC(mess.pVon); END; (* Freundlichkeit fr CAT *)
RETURN FALSE;
(* enemy Message entering .. *)
END DeflectorShieldsStrongEnough;
PROCEDURE AppendZero(start, next : LONGCARD);
(* start : Startbyte der Zeile, next : Startbyte der nchsten Zeile *)
(* In den gepufferten Text an passender Stelle ein Nullbyte schreiben *)
BEGIN
IF next >= start + 2 THEN
oPtr^[next-2] := 0C;
(* Dort sollte das CR stehen, wenn nicht ist etwas schiefgelaufen *)
ELSE
oPtr^[start] := 0C;
(* Dann mu man wohl von einer leeren Zeile ausgehen *)
END;
END AppendZero;
PROCEDURE checkCopy(ptr : CatTypes.Str255Ptr):BOOLEAN;
(* Stellt fest, ob es sich bei der bergebenen Msg um eine *)
(* kopierte oder weitergegebene Msg handelt. *)
VAR saveChar : CHAR;
BEGIN
saveChar := ptr^[11]; ptr^[11] := 0C;
IF MagicStrings.Equal('Kopiert von', ptr^) THEN
ptr^[11] := saveChar;
RETURN TRUE
ELSE
ptr^[11] := saveChar;
saveChar := ptr^[17]; ptr^[17] := 0C;
IF MagicStrings.Equal('Weitergegeben von', ptr^) THEN
ptr^[17] := saveChar;
RETURN TRUE
ELSE
ptr^[17] := saveChar;
RETURN FALSE
END;
END;
END checkCopy;
(*
PROCEDURE prepareText (pText: ADDRESS; VAR count: LONGCARD; VAR TextMax: CARDINAL);
BEGIN
ASSEMBLER
(* Die Routine knnte man prinzipiell durch eine Assemblerroutine ersetzen
* Hier wird folgendes gemacht: Die Doppelpunkte am Anfang der Zeile
* werden entfernt, und CR/LFs werden durch einzelne LFs ersetzt
* Das wird solange gemacht, bis entweder die maximale Messagelnge
* erreicht ist oder der Anfang der nchsten Nachricht gefunden wurde
*)
MOVE.L count(A6),A0 ; Zhler nach D0
MOVE.L (A0),D0
MOVE.L TextMax(A6),A0 ; TextMax nach D1
MOVE.W (A0),D1
EXT.L D1
MOVE.L pText(A6),A0 ; Zeiger auf Text nach A0 (oPtr^[old])
MOVE.L A0,A1 ; Zeiger auf Text nach A1 (oPtr^[count])
MOVEQ #0,D2 ; Zwischenspeicher
ADDQ.L #1,D0
outer_loop:
ADDA.W #1,A1 ; Adresse um eins erhhen
inner_loop:
MOVE.B (A1)+,D2 ; Zwischenspeichern
MOVE.B D2,(A0)+ ; Byte umkopieren
ADDQ.L #1,D0
ADDQ.L #1,D1 ; TextMax erhhen
CMPI.L #sixteenKB,D1
BGE.S end_outer
CMPI.B #CR,D2
BEQ.S end_inner
CMPI.B #0,D2
BNE.S inner_loop
end_inner:
MOVE.B #LF,-1(A0) ; CR durch LF ersetzen
ADDA.W #1,A1 ; LF berspringen
MOVE.B (A1),D2
CMPI.B #"#",D2
BNE.S outer_loop
end_outer:
MOVE.L count(A6),A0 ; Zhler nach A0
MOVE.L D0,(A0) ; Variable zurckschreiben
MOVE.L TextMax(A6),A0 ; TextMax nach A0
MOVE.W D1,(A0) ; Variable zurckschreiben
END;
END prepareText;
*)
VAR isCopy : BOOLEAN; (* Gibt an, ob es sich bei der bearbeiteten Msg *)
(* um eine Kopie handelt. Dann wird der Header *)
(* nmlich doch mit in die Message gepackt *)
bitWhishes : BITSET; (* Hier werden die Flags bergeben, die direkt *)
(* beim Einfgen gesetzt werden sollen. *)
pFlagLine : CatTypes.Str255Ptr; (* Pointer auf Zeile mit Flags *)
usenetChain, usenetOk : BOOLEAN;
typeInfo : BOOLEAN;
tmpAdr : ADDRESS;
tmp : CatTypes.nameStrType;
BEGIN
bitWhishes := {}; (* Normalerweise htten wir gerne leere Bits *)
typeInfo := FALSE;
count := MessStart; (* MessStart zeigt auf den ersten char nach '#' *)
old := count;
start := old; (* Fr die Fllstandsanzeige *)
CheckMemLine(count, oPtr, oAnz); (* Zeile auslesen, MausNr *)
AppendZero(old, count);
WITH toData DO
pId := ADR(oPtr^[old]);
(* Alles andere mu nicht kommen und wird erstmal auf null gesetzt *)
whatsThere := data.stringSet{data.bId};
pRefNr := NIL; pVon := NIL; (* kommentierte Msg, Absender *)
pAn := NIL; pWegen := NIL; (* Empfnger, Betreff *)
pEZeit := NIL; pGruppe:= NIL; (* Eingabezeit, Gruppe *)
pBSZeit:= NIL; pMId := NIL; (* Bearb.status+Zeit, MessageID *)
pRId := NIL; pBox := NIL; (* RId gem. Def., BoxInfo *)
pName := NIL; (* Name gem. Def falls # Absender *)
pGate := NIL; (* Gateway-Zeile *)
pMime := NIL; (* MIME-Zeile *)
pFollowupTo := NIL; (* FollowupTo-Zeile *)
pReplyTo := NIL; (* ReplyTo-Zeile *)
pSender := NIL; (* Sender-Zeile *)
pText := NIL; (* MsgText *)
TextMax := 0;
pDistribution := NIL;
isCopy := FALSE; (* Normalerweise handlet es sich nicht um eine Kopie *)
(* Header abarbeiten *)
REPEAT
old := count;
CheckMemLine(count, oPtr, oAnz);
AppendZero(old, count);
(* die folgende Adresse nur einmal berechnen, spart Code *)
tmpAdr := ADR(oPtr^[old+1]);
CASE oPtr^[old] OF
'-' : pRefNr :=tmpAdr; INCL(whatsThere, data.bRefNr)|
'V' : pVon :=tmpAdr; INCL(whatsThere, data.bVon);
IF checkOwn THEN
IF MagicStrings.Equal(pVon^, ownName) THEN
INCL(bitWhishes, dataSys.bOwnMessage);
ELSE
MagicStrings.Copy (pVon^, 0, 6, tmp);
MagicStrings.CAPS (tmp);
IF MagicStrings.Pos (cSysop, tmp, 0, FALSE) = 0
THEN
(* Test auf eigene Nachricht als Sysop *)
IF MagicStrings.Pos (ownName, pVon^, LENGTH(cSysop), FALSE) < SIZE (pVon^)
THEN
INCL(bitWhishes, dataSys.bOwnMessage);
END;
END;
END;
END |
'A' : pAn :=tmpAdr; INCL(whatsThere, data.bAn)|
'W' : pWegen :=tmpAdr; INCL(whatsThere, data.bWegen)|
'E' : pEZeit :=tmpAdr; INCL(whatsThere, data.bEZeit)|
'G' : pGruppe:=tmpAdr; INCL(whatsThere, data.bGruppe)|
'B' : pBSZeit:=tmpAdr; INCL(whatsThere, data.bBSZeit)|
'I' : pMId :=tmpAdr; INCL(whatsThere, data.bMId)|
'R' : pRId :=tmpAdr; INCL(whatsThere, data.bRId)|
'O' : pBox :=tmpAdr; INCL(whatsThere, data.bBox)|
'N' : pName :=tmpAdr; INCL(whatsThere, data.bName)|
'Y' : pGate :=tmpAdr; INCL(whatsThere, data.bGate)|
'M' : pMime :=tmpAdr; INCL(whatsThere, data.bMime)|
'F' : pFollowupTo :=tmpAdr; INCL(whatsThere, data.bFollowupTo)|
'T' : pReplyTo :=tmpAdr; INCL(whatsThere, data.bReplyTo)|
'D' : pDistribution := tmpAdr; INCL(whatsThere, data.bDistribution)|
'S' : pSender :=tmpAdr; INCL(whatsThere, data.bSender)|
'>' : isCopy := checkCopy(tmpAdr); IF isCopy THEN count := old; END; |
's' : pFlagLine := tmpAdr; CheckFlagLine (pFlagLine, bitWhishes); |
'*' : (* Nachrichtentyp *)
typeInfo := TRUE;
CASE oPtr^[old+1] OF
'A' : what := data.normal; |
'P' : what := data.personal; |
'S' : what := data.status; |
ELSE
typeInfo := FALSE;
END;
|
ELSE (* Sonst nichts machen *)
helpPtr := ADR(oPtr^[old]);
CatLog.WriteStringNTime('Unbekannte Zeilen-ID: ');
CatLog.WriteLine(helpPtr^);
END;
UNTIL isCopy OR (oPtr^[count] IN CatTypes.charSet{(*'>',*) ':', '#'});
(* Beginn des Headers, der Message oder Ende *)
IF (oPtr^[count] # '#') THEN (* Dann kommt noch eine Nachricht *)
pText := ADR(oPtr^[count]);
INCL(whatsThere, data.bText);
old := count;
(* In prepareText wird genau das gleiche wie in der Routine unten
* gemacht, nur in Assembler
*)
(*
prepareText (pText, count, TextMax);
*)
REPEAT
INC(count); (* Anfangsbuchstaben berspringen *)
REPEAT (* eine Zeile lesen.. *)
oPtr^[old] := oPtr^[count];
INC(TextMax);
INC(count);
INC(old);
UNTIL (TextMax >= sixteenKB) OR (oPtr^[old-1] IN CatTypes.charSet{CR, 0C}) OR (count >= oAnz);
IF count < oAnz
THEN
(* ..bis zum CR *)
oPtr^[old-1] := LF; (* CR durch LF ersetzen *)
INC(count); (* LF berspringen *)
END;
UNTIL (oPtr^[count] = '#') OR (TextMax >= sixteenKB) OR (count >= oAnz);
(* bis zum Ende dieser Msg oder 16k *)
END;
END; (* WITH toData DO *)
IF (count < oAnz)
THEN
showImport.SetNew(count-start);
CatGlobal.busyMouse();
IF ~typeInfo
THEN
what := data.PreCheck(toData);
END;
IF what = data.status THEN INC(status) END;
IF what = data.garbage THEN
INC(garbage);
data.dumpMess(toData);
ELSIF DeflectorShieldsStrongEnough(toData, what, bitWhishes) THEN
INC(watch);
ELSE
(*
IF useLongIds
THEN
WITH toData DO
IF (data.bMId IN whatsThere)
THEN
(* MId ist vorhanden, vertauschen mit normaler Id *)
tmpAdr := pId;
pId := pMId;
pMId := tmpAdr;
END;
IF (data.bRId IN whatsThere)
THEN
IF (data.bRefNr IN whatsThere)
THEN
(* Vertauschen mit RId *)
tmpAdr := pRId;
pRId := pRefNr;
pRefNr := tmpAdr;
ELSE
(* keine RefNr da, dann machen wir die RId zur RefNr
*)
pRefNr := pRId;
pRId := NIL;
INCL (whatsThere, data.bRefNr);
EXCL (whatsThere, data.bRId);
END;
END;
END; (* IF useLongIds *)
END;
*)
IF data.AppendMessage(handle, what, bitWhishes, toData, usenetChain, usenetOk, isDupe, abort) (* ACHTUNG, v.bool eigentlich ABORT! - > SOFORT ABBRECHEN *)
THEN
IF usenetChain THEN
INC(USENETCHAIN);
CatLog.WriteStringNTime("Usenetverkettung bei ");
CatLog.WriteString(toData.pId^);
IF usenetOk THEN
INC(USENETOK);
CatLog.WriteLine(" hergestellt.");
ELSE
CatLog.WriteLine(" fehlgeschlagen.");
END;
END;
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END;
ELSE
CatLog.WriteStringNTime ("Internal error in parser, crash avoided, message possibly lost");
END;
(* Message -> data *)
RETURN TRUE; (* Nicht von der Datenbank abgelehnt *)
END WriteOneMsg;
VAR actualElem : CARDINAL; (* Aktueller MsgPointer im Array *)
groupScrap : CatTypes.String1023;
isDupe : BOOLEAN;
BEGIN
anz := 0; not := 0; watch := 0; garbage := 0; status := 0;
dupeCount := 0;
actualElem := gStart[gruppe];
IF actualElem # EndOfList THEN
CatLog.WriteLn();
CatLog.WriteStringNTime(cGroupChange);
IF gruppe = dataSys.private THEN
CatLog.WriteLine(cPrivate);
ELSIF gruppe <= maxGroup THEN
GroupSelect.GroupName(gruppe, groupScrap);
CatLog.WriteLine(groupScrap);
ELSE
CatLog.WriteLine('unknown');
END;
IF ~data.OpenOneGroup(gruppe, 1000, TRUE, handle) THEN
CatLog.WriteLineNTime('ffnen der Datenbank nicht mglich');
RETURN FALSE
END;
REPEAT
IF ~WriteOneMsg(gruppe, gPos^[actualElem].offset, checkOwn, ownName, USENETCHAIN, USENETOK, isDupe, abort) THEN
IF isDupe
THEN
INC (dupeCount);
END;
INC(not);
END;
INC(anz);
IF anz MOD CARDINAL(redrawCheck) = 0 THEN HandleEvents(); END;
actualElem := gPos^[actualElem].next;
UNTIL (actualElem = EndOfList) OR abort;
IF ~abort THEN
data.CloseOneWriteGroup(handle, anz-not-watch-garbage-status, TRUE, abort);
ELSE
data.CloseOneWriteGroup(handle, anz-not-watch-garbage-status, FALSE, v.bool);
END;
CatLog.putTime();
CatLog.WriteCard(anz-not-watch-garbage-status);
CatLog.WriteString(' von ');
CatLog.WriteCard(anz-status);
CatLog.WriteKonjString (cMessStr,'',cExtStr, anz-status);
CatLog.WriteLine(cImpStr);
CatLog.WriteString(' ');
CatLog.WriteCard(not);
CatLog.WriteString(cDbStr);
CatLog.WriteCard(watch);
CatLog.WriteLine(cWdogStr);
CatLog.WriteString(cSpace9Str);
CatLog.WriteCard(garbage);
CatLog.WriteKonjString (cMessStr,'',cExtStr, garbage);
CatLog.WriteKonjString (cWarStr,'',cExtStr, garbage);
CatLog.WriteLine(' fehlerhaft.');
IF gruppe = dataSys.private THEN
CatLog.WriteString(cSpace9Str);
CatLog.WriteCard(status);
CatLog.WriteKonjString (' Statusmeldung','','en', status);
CatLog.WriteLine(cImpStr);
END;
END;
RETURN ~abort
END WriteOneGroup;
VAR z : CARDINAL;
mBuff: ARRAY [0..15] OF INTEGER;
dr : RECORD
CASE :BOOLEAN OF
TRUE : x,y,w,h : INTEGER|
FALSE: adr, dum: ADDRESS
END
END;
event,
evnt : BITSET;
doExit : BOOLEAN;
moX, moY : INTEGER;
moButton : BITSET;
kReturn : INTEGER;
moKState : BITSET;
bReturn : INTEGER;
scan : INTEGER;
sc,
ch : CHAR;
BEGIN
FOR z := 0 TO maxGroup DO
IF (z IN groupsUsed) THEN
IF ~WriteOneGroup(z, checkOwn, ownName, not, watch, anz, garbage, status, dupeCount, USENETCHAIN, USENETOK, abort) THEN
RETURN
ELSE
INC(gNot, not); INC(gWatch, watch); INC(gAnz, anz);
INC(gGarbage, garbage); INC(gStatus, status); INC (gDupeCount, dupeCount);
IF z = 0 THEN pmNot := not + garbage END; (* Anzahl der Fehler in PMs *)
END;
HandleEvents();
END;
END;
END WriteBufferedOutfile;
(*-------------------------------------------------------------------------*)
PROCEDURE HandleOutfileBuffer (gPos : onePosArrayPtr;
VAR gMax,
gStart : oneMaxArray;
VAR TxtOut : mtTextfiles.TEXTFILE;
VAR TxtOutOpen : BOOLEAN;
VAR TxtName: ARRAY OF CHAR;
VAR maxPos : CARDINAL;
oPtr : CatTypes.LargeTextPtr;
oAnz : LONGCARD;
VAR count : LONGCARD;
processed : LONGCARD;
VAR not, watch, anz, garbage, status, pmNot, dupeCount, text, unknown : CARDINAL;
VAR USENETCHAIN, USENETOK : CARDINAL;
checkOwn : BOOLEAN;
ownName : ARRAY OF CHAR;
VAR abort : BOOLEAN):BOOLEAN;
(* Durchsucht den angelegten Puffer, schreibt auftretende Textfiles *)
(* in die entsprechenden Dateien und legt Listen mit den Anfngen der *)
(* einzelnen Mitteilungen an *)
(* Der Puffer wird bis oAnz durchsucht *)
(* count gibt an, wo die Suche anfangen soll *)
(* normalerweise 1, damit das erste '#' bersprungen wird *)
VAR brokenMessage : BOOLEAN; (* Message auf Puffergrenze *)
BEGIN
REPEAT
InitList(gPos, gMax, gStart, maxPos);
REPEAT
brokenMessage := ~HandleMessage(gPos, gMax, gStart,
TxtOut, TxtOutOpen, TxtName, maxPos, count, text, unknown, oPtr, oAnz);
(* Dann wurde am Ende eine Msg durch die Puffergrenze getrennt -> kopieren *)
(* old enthlt die Startposition der letzten Message *)
UNTIL brokenMessage OR
(maxPos >= maxArray) OR (* YYYY *)
(count >= oAnz) OR
(oPtr^[count] = CR) & (oPtr^[count+1] = LF);
WriteBufferedOutfile(oPtr, oAnz, checkOwn, ownName, gPos, gStart,
not, watch, anz, garbage, status, pmNot, dupeCount,
USENETCHAIN, USENETOK,
abort);
UNTIL brokenMessage OR
(count >= oAnz) OR
(oPtr^[count] = CR) & (oPtr^[count+1] = LF) OR
abort;
RETURN brokenMessage
END HandleOutfileBuffer;
PROCEDURE OutfileEinsortieren():BOOLEAN;
VAR estMem : LONGCARD; (* Vermutete ntige Gre fr die Pufferung *)
isAvail : LONGCARD; (* Vorhandener Speicher *)
toAlloc : LONGCARD; (* Berechnung des anzufordernden Speichers *)
scrap : CatTypes.pathStrType; (* Zugriffspfade erstellen *)
doDeArc : BOOLEAN; (* Auspacken ntig? *)
convertOk : BOOLEAN; (* hat da Einfgen bisher geklappt? *)
txtIsThere : BOOLEAN; (* Ist ein Outfile-Text schon vorhanden? *)
outHandle : INTEGER; (* Handle des Outfiles *)
outLength : LONGCARD;(* Lnge des Outfiles *)
processed : LONGCARD;(* Wieviele Bytes wurden schon behandelt? *)
oAnz : LONGCARD;(* Ende des Puffers bei oAnz *)
oPtr : CatTypes.LargeTextPtr; (* Zugriffpointer auf den Puffer *)
TxtOut : mtTextfiles.TEXTFILE;
TxtOutOpen : BOOLEAN; (* Ist noch eine Datei offen? *)
TxtName : CatTypes.nameStrType;
maxPos : CARDINAL; (* Nchste zu belegende Stelle im PointerArray *)
count : LONGCARD; (* Zhlvariable fr die Behandlungsprozeduren *)
toRead : LONGCARD; (* Berechnung der Anzahl zu lesender Bytes *)
abort : BOOLEAN; (* Abbruch wegen Dateifehlers beim Schreiben auf *)
(* die Datenbank *)
isWatch,
WatchActive : BOOLEAN; (* WatchDog installiert und aktiv, nur fr Protokoll *)
(* Fr die Statistik *)
not, watch, anz, garbage, status, dupeCount, text, unknown : CARDINAL;
gNot, gWatch, gAnz, gGarbage, gStatus, pmNot, gDupeCount, gText, gUnknown : CARDINAL;
hasMxAlloc : BOOLEAN;
(* Fr's Aufrumen *)
inMctrl : BOOLEAN;
infoWdwOpen: BOOLEAN;
USENETCHAIN,
USENETOK : CARDINAL;
checkOwn : BOOLEAN;
ownName : CatTypes.String127;
PROCEDURE cleanUp ();
BEGIN
CatLog.CloseLog();
IF inMctrl THEN MagicAES.WindUpdate (MagicAES.ENDMCTRL); inMctrl := FALSE; END;
IF CatGlobal.multiTask
THEN
(* MagicAES.WindUpdate wieder setzen und Menu wieder anschalten *)
VDIStandards.enableOrDisableMenu (FALSE);
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
END;
IF infoWdwOpen THEN showImport.Close(); END;
mtAppl.MouseArrow();
END cleanUp;
BEGIN
gNot := 0; gWatch := 0; gAnz := 0; gGarbage := 0;
gStatus := 0; pmNot := 0; gDupeCount := 0; gText := 0; gUnknown := 0;
USENETCHAIN := 0; USENETOK := 0;
maxOver := FALSE;
firstLog := FALSE;
headThere := FALSE;
abort := FALSE;
inMctrl := FALSE;
infoWdwOpen := FALSE;
IF ~CatLog.OpenLog() THEN
MTE.info(MTE.noCatlog);
RETURN FALSE;
END;
ConfVars.GetConfDefInt (cRedrawCheck, redrawCheck, 40);
checkOwn := ConfVars.GetConfigString(cOwnName, ownName);
IF checkOwn
THEN
MagicStrings.Assign (CatGlobal.userName, ownName);
END;
ConfVars.GetConfDefBool (cFilteredRead, filteredToRead, FALSE);
(*
ConfVars.GetConfDefBool (cUseLongIDs, useLongIds, FALSE);
*)
CatGlobal.busyMouse();
IF CatGlobal.multiTask THEN
(* Bildschirm freigeben und alle Menus sperren
*)
VDIStandards.enableOrDisableMenu (TRUE);
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
END;
convertOk := FALSE; (* bisher ist es schiefgelaufen :-) *)
doDeArc := ARCName[0] # 0C; (* auspacken, wenn Packer angemeldet *)
abort := FALSE;
IF handlePool.isOneGroupOpen() THEN
CatLog.WriteLineNTime('Interner Fehler in der Lesehandleliste. Einfgen abgebrochen.');
CatLog.CloseLog();
MTE.info(MTE.groupsOpen);
RETURN FALSE;
END;
MagicStrings.Assign(ImportPath, scrap);
MagicStrings.Append(OutfileTxt, scrap);
txtIsThere := CatFiles.Exists (scrap); (* Outfile.txt da? *)
MagicStrings.Assign(ImportPath, scrap);
MagicStrings.Append(archiveName, scrap);
IF doDeArc & ~CatFiles.Exists (scrap) THEN (* Ist das Outfile berhaupt da? *)
CatLog.WriteLineNTime('Outfile-Archiv nicht gefunden');
IF ~batchProcess THEN
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
END;
MTE.info(MTE.noOutArc); (* Outfile nicht vorhanden ! *)
IF txtIsThere THEN CatLog.WriteLineNTime('Outfile-Text ist vorhanden'); END;
IF txtIsThere & (mtAlerts.Alert(1, MTE.doInsert) = 1) THEN
doDeArc := FALSE; (* trotzdem einfgen! *)
CatLog.WriteLineNTime('User besttigt: Outfile-Text trotzdem einfgen.');
ELSE
IF txtIsThere THEN
CatLog.WriteLineNTime('User lehnt einfgen vom Outfile-Text ab');
END;
(* Aufrumen *)
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
END;
cleanUp();
RETURN FALSE (* nicht da oder nicht gewollt *)
END;
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
END;
ELSE
CatLog.WriteLineNTime('Einfgen abgebrochen, da Batchbetrieb');
cleanUp;
RETURN FALSE
END;
END;
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
END;
IF ~OutfileVorbereiten(doDeArc, txtIsThere, outHandle, outLength) THEN
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
END;
cleanUp();
RETURN FALSE
END;
IF CatGlobal.multiTask THEN
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
END;
(* Altes Logfile lschen *)
v.bool := CatFiles.DeleteFile (DataPath, LogFile);
MagicAES.WindUpdate(MagicAES.BEGMCTRL); (* Prozewechsel sperren *)
inMctrl := TRUE;
estMem := data.EstimateNecessaryMemory();
CatLog.putTime();
CatLog.WriteCard(outLength);
CatLog.WriteLine(' Bytes Outfile Lnge. ');
CatLog.putTime();
CatLog.WriteCard(estMem);
CatLog.WriteLine(' Bytes schtzt das Datenbankmodul als Speicherbedarf');
(* Schleife, da sich z.B. bei MiNT der freie Speicher zwischen fragen und *)
(* Anforderung ndern kann. Aus demselben Grund kann die Pufferung der *)
(* Parameterdateien auch jetzt noch schiefgehen, aber ich wei nicht, wie *)
(* man das umgehen kann. *)
hasMxAlloc := MagicDOS.Mxalloc ($FFFFFFFF,3) # ADDRESS(-32L);
REPEAT
CatLog.WriteLineNTime('Beginne Allozierungsschleife');
isAvail := MagicDOS.Malloc(LONG(-1)); (* Wieviel ist da? *)
(* isAvail := estMem + 37331; (* YYYY wieder wegmachen *) *)
(* isAvail := minSpace; *)
CatLog.putTime();
CatLog.WriteCard(isAvail);
CatLog.WriteLine(' Bytes grter Speicherblock');
IF isAvail < minSpace THEN
CatFiles.CloseFile(outHandle);
CatLog.WriteLineNTime('Nicht genug Speicher frei fr das Einfgen');
mtAppl.MouseArrow();
MTE.noMemAlert();
cleanUp();
RETURN FALSE;
ELSIF isAvail < estMem + minSpace THEN
(* Parameterdatei pat vermutlich nicht rein, oder kein Platz mehr fr das *)
(* Outfile *)
(* Alert kommt nur, wenn nicht abgeschaltet *)
ConfVars.GetConfDefBool (cBufferAlert, v.bool, TRUE);
IF ~batchProcess & v.bool &
(mtAlerts.Alert(2, MTE.noMemForBuffer) = 2)
THEN
CatFiles.CloseFile(outHandle);
CatLog.WriteLineNTime('User lehnt Einfgen ab; Pufferspeicher zu klein');
cleanUp;
RETURN FALSE
ELSE
oAnz := BinOps.LowerLCard(minSpace, outLength);
(* Nur das anfordern, was ntig ist, aber hchstens minSpace *)
CatLog.WriteStringNTime('Minimumspeicher: ');
END;
ELSIF isAvail < estMem + outLength THEN
oAnz := isAvail-estMem; (* Anfordern, was mglich ist *)
CatLog.WriteStringNTime('Teilpufferung: ');
ELSE
oAnz := outLength; (* Alles anfordern, Outfile pat komplett *)
CatLog.WriteStringNTime('Vollpufferung: ');
END;
IF hasMxAlloc & (CatGlobal.multiTOS OR CatGlobal.magIx)
THEN
(* Alloziere Speicher readable und TT-RAM preferred *)
oPtr := MagicDOS.Mxalloc(oAnz, $43);
ELSE
(* Normal allozieren *)
oPtr := MagicDOS.Malloc(oAnz);
END;
CatLog.WriteCard(oAnz); CatLog.WriteLine(' Bytes angefordert');
UNTIL oPtr # NIL; (* Wir machen den Spa solange, bis es geklappt hat.. *)
inMctrl := FALSE;
MagicAES.WindUpdate(MagicAES.ENDMCTRL);(* Prozewechsel wieder freigeben *)
CatLog.WriteLineNTime('Ende der Allozierungsschleife, Speicher angefordert');
CatLog.WriteLn();
CatLog.WriteLineNTime('Beginn des Einfgens');
Protokoll.isWatchDog(isWatch, WatchActive);
CatLog.WriteLn();
CatLog.WriteString(' ');
IF isWatch THEN
CatLog.WriteString('WatchDog installiert und ');
IF ~WatchActive THEN CatLog.WriteString('nicht '); END;
CatLog.WriteString('aktiv.');
ELSE
CatLog.WriteString('Kein WatchDog installiert.');
END;
showImport.Open(outLength);
HandleEvents();
infoWdwOpen := TRUE;
data.PrepareToWrite();
CatFiles.Seek(0, outHandle, CatFiles.start);
processed := 0; (* Bisher wurde nichts behandelt *)
count := 0; (* Anzahl der Restbytes von der letzten Runde *)
TxtOutOpen:= FALSE; (* und auch keine Textdatei offen *)
(* Achtung, hier wird count fr zwei verschiedene Funktionen gebraucht! *)
REPEAT
not := 0; watch := 0; anz := 0; garbage := 0; status := 0; text := 0; unknown := 0; dupeCount := 0;
(*
CatLog.WriteString('--- Repeat-Schleife in Outfile-Einsortieren ---');CatLog.WriteLn();
CatLog.WriteString('processed:');CatLog.WriteCard(processed);CatLog.WriteLn();
CatLog.WriteString('count:');CatLog.WriteCard(count);CatLog.WriteLn();
*)
toRead := BinOps.LowerLCard(oAnz-count, outLength-processed-count); (* -count neu! *)
oAnz := BinOps.LowerLCard(oAnz, outLength-processed); (* + count weg! *)
(* Am Ende brauchen wir nicht mehr soviel und die Prozeduren oben *)
(* mssen das auch erfahren *)
CatFiles.ReadMuch(toRead, outHandle, ADR(oPtr^[count]));
IF CatFiles.FileError < 0 THEN
CatFiles.ErrorAlert(CatFiles.FileError);
v.bool := MagicDOS.Mfree(oPtr);
cleanUp();
RETURN FALSE
END;
count := 1; (* Warum steht hier eine 1????? YYYY jetzt funktioniert's! *)
(*CatLog.WriteString('oAnz:');CatLog.WriteCard(oAnz);CatLog.WriteLn();*)
IF HandleOutfileBuffer(ADR(g), m, s, (* vorlufig *)
TxtOut, TxtOutOpen, TxtName,
maxPos, oPtr, oAnz, count, processed,
not, watch, anz, garbage, status, pmNot, dupeCount, text, unknown,
USENETCHAIN, USENETOK,
checkOwn, ownName,
abort) THEN
INC(processed, count);
(* Hier mu kopiert werden, da eine Msg auf der Puffergrenze steht *)
(* count steht auf der Startposition der getrennten Message *)
(* Den Block nach vorne schieben *)
Block.Copy(ADR(oPtr^[count]), oAnz-count, oPtr);
count := oAnz-count; (* Anzahl der Restbytes *)
ELSE
count := 0; (* keine Restbytes *)
INC(processed, oAnz);
END;
(*CatLog.WriteString('count:');CatLog.WriteCard(count);CatLog.WriteLn();*)
INC(gNot, not); INC(gWatch, watch); INC(gAnz, anz);
INC(gGarbage, garbage); INC(gStatus, status); INC(gText, text);
INC (gDupeCount, dupeCount); INC (gUnknown, unknown);
UNTIL (processed >= outLength) OR abort; (* BIS ALLES DURCHGENUDELT IST *)
CatFiles.CloseFile(outHandle); (* Hier ist ein Fehler tolerierbar *)
IF CatFiles.FileError < 0 THEN CatFiles.ErrorAlert(CatFiles.FileError) END;
v.bool := MagicDOS.Mfree(oPtr); (* Vielleicht mal meckern..? *)
IF ~abort & (gGarbage = 0) & (gNot - gDupeCount = 0) & UserBLK.DeleteAfterDecode THEN (* Soll gelscht werden ? *)
IF ~CatFiles.DeleteFile(ImportPath, OutfileTxt) THEN
(* OUTFILE.TXT lschen.. *)
CatFiles.ErrorAlert(CatFiles.FileError);
CatLog.WriteLineNTime(cOfNdel);
ELSE
CatLog.WriteLineNTime(cOfDel);
END
ELSIF ~abort & UserBLK.DeleteAfterDecode
THEN
CatLog.WriteStringNTime('Outfile-Text nicht gelscht, da ');
IF gGarbage # 0
THEN
CatLog.WriteCard (gGarbage);
CatLog.WriteKonjString (cMessStr,'',cExtStr, gGarbage);
CatLog.WriteString (' kaputt ');
IF (gNot - gDupeCount = 0)
THEN
CatLog.WriteKonjString (cWarStr,'.','en.', gGarbage);
CatLog.WriteLn;
ELSE
CatLog.WriteString ('und ')
END;
END;
IF (gNot - gDupeCount # 0)
THEN
CatLog.WriteCard (gNot - gDupeCount);
CatLog.WriteKonjString (cMessStr,'',cExtStr, gNot - gDupeCount);
CatLog.WriteString (' abgelehnt ');
CatLog.WriteKonjString ('wurde','.','n.', gNot-gDupeCount);
CatLog.WriteLn;
END;
END;
IF ~abort THEN
processLog();
(* Hier werden jetzt die Filter nach dem Einfgen aufgerufen *)
CatLog.WriteLn();
v.bool := data.WritePos();
IoFilter.IoFilterPastOutfile();
v.bool := data.ReadPos();
Messages.ReReadMessageInfo();
END;
CatLog.WriteLn();
CatLog.putTime();
CatLog.WriteLine('--- Gesamtstatistik ---');
CatLog.WriteString(cSpace9Str);
CatLog.WriteCard(gAnz-gNot-gWatch-gGarbage-gStatus);
CatLog.WriteString(' von ');
CatLog.WriteCard(gAnz-gStatus);
CatLog.WriteKonjString (cMessStr,'',cExtStr, gAnz-gStatus);
CatLog.WriteLine(cImpStr);
CatLog.WriteString(cSpace9Str);
CatLog.WriteCard(gNot);
CatLog.WriteString(cDbStr);
CatLog.WriteCard(gWatch);
CatLog.WriteLine(cWdogStr);
CatLog.WriteString(cSpace9Str);
CatLog.WriteCard(gGarbage);
CatLog.WriteKonjString (cMessStr,'',cExtStr, gGarbage);
CatLog.WriteKonjString (cWarStr,'',cExtStr, gGarbage);
CatLog.WriteLine(' fehlerhaft.');
CatLog.WriteString(cSpace9Str);
CatLog.WriteCard(gDupeCount);
CatLog.WriteKonjString (cMessStr,'',cExtStr, gDupeCount);
CatLog.WriteKonjString (cWarStr,' ein',cExtStr, gDupeCount);
CatLog.WriteKonjString (' Dupe','','s', gDupeCount);
CatLog.WriteLine('.');
CatLog.WriteKonjString(' Es kam',' ','en ', gText);
CatLog.WriteCard(gText);
CatLog.WriteKonjString(' Maus-Infotext','','e', gText);
CatLog.WriteLine('.');
CatLog.WriteKonjString(' Es kam',' ','en ', gUnknown);
CatLog.WriteCard(gUnknown);
CatLog.WriteKonjString(' unbekannte', 'r', '', gUnknown);
CatLog.WriteKonjString(' Infotext','','e', gUnknown);
CatLog.WriteLine('.');
CatLog.WriteString(cSpace9Str);
CatLog.WriteCard(gStatus);
CatLog.WriteKonjString(' Statusmeldung','','en', gStatus);
CatLog.WriteLine (cImpStr);
CatLog.WriteString(' ');
CatLog.WriteCard(USENETCHAIN);
CatLog.WriteKonjString(' Usenet-Verkettung','','en', USENETCHAIN);
CatLog.WriteKonjString(' wurde','','n', USENETCHAIN);
CatLog.WriteString(" gefunden, ");
CatLog.WriteCard(USENETOK);
CatLog.WriteKonjString(' konnte','','n', USENETOK);
CatLog.WriteLine(" hergestellt werden.");
CatLog.CloseLog();
IF CatGlobal.multiTask
THEN
(* MagicAES.WindUpdate wieder setzen und Menu wieder anschalten *)
VDIStandards.enableOrDisableMenu (FALSE);
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
END;
showImport.Close();
mtAppl.MouseArrow();
v.bool := data.WritePos();
IF ~batchProcess
THEN
MTE.warnAlert (pmNot # 0, MTE.pmDefect, '','');
IF maxOver
THEN
v.int := mtAlerts.Alert (2, MTE.overSize);
IF v.int = 1
THEN
CatHelp.DoHelp (CatHelp.oversize);
END;
END;
END;
Protokoll.SendPathUpdate (MessagePath);
Protokoll.SendPathUpdate (DataPath);
RETURN TRUE
END OutfileEinsortieren;
PROCEDURE EmergencyClose();
(* Schliet die noch offene Protokolldatei im Falle eines Absturzes *)
(* Wird direkt in cat.m in den ExeptionHandler gehngt. *)
BEGIN
CatLog.WriteLn();
CatLog.WriteLine('### catlog.txt durch Traphandler geschlossen ###');
CatLog.CloseLog();
END EmergencyClose;
END Parser.